home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pseudo-s / pseudo_2.lha / reflect.pso < prev    next >
Encoding:
Text File  |  1992-02-17  |  5.6 KB  |  117 lines
  1. ; -*- Mode: Lisp; Syntax: Common-Lisp; Package: SCHEME-TRANSLATOR; -*-
  2.  
  3. ; This file was generated by Pseudoscheme 2.8a
  4. ;  running in Lucid Common Lisp 4.0.1
  5. ;  from file /amd/night/b/jar/pseudo/reflect.scm
  6.  
  7. (SCHI:BEGIN-TRANSLATED-FILE)
  8. (LOCALLY (DECLARE (SPECIAL SCHEME-TRANSLATOR-ENV
  9.                            REVISED^4-SCHEME-MODULE))
  10.          (SETQ SCHEME-TRANSLATOR-ENV (MAKE-PROGRAM-ENV
  11.                                        'SCHEME::SCHEME-TRANSLATOR
  12.                                        (LIST REVISED^4-SCHEME-MODULE))))
  13. (SCHI:SET-FUNCTION-FROM-VALUE 'SCHEME-TRANSLATOR-ENV
  14.                               'SCHEME::SCHEME-TRANSLATOR-ENV)
  15. (LOCALLY (DECLARE (SPECIAL SCHEME-TRANSLATOR-SIG))
  16.          (SETQ SCHEME-TRANSLATOR-SIG (MAKE-SIGNATURE 'SCHEME::SCHEME-TRANSLATOR
  17.                                                      '(SCHEME::MAKE-PROGRAM-ENV
  18.                                                        SCHEME::MAKE-SIGNATURE
  19.                                                        SCHEME::MAKE-MODULE
  20.                                                        SCHEME::PROGRAM-ENV-ID
  21.                                                        SCHEME::PROGRAM-ENV-PACKAGE
  22.                                                        SCHEME::PROGRAM-ENV-LOOKUP
  23.                                                        SCHEME::PROGRAM-ENV-DEFINE!
  24.                                                        SCHEME::TRANSLATE
  25.                                                        SCHEME::TRANSLATE-LAMBDA
  26.                                                        SCHEME::REALLY-TRANSLATE-FILE
  27.                                                        SCHEME::TRANSLATOR-VERSION
  28.                                                        SCHEME::PERFORM-USUAL-INTEGRATIONS!
  29.                                                        SCHEME::SCHEME-TRANSLATOR-ENV
  30.                                                        SCHEME::SCHEME-TRANSLATOR-MODULE
  31.                                                        SCHEME::REVISED^4-SCHEME-MODULE
  32.                                                        SCHEME::SCHEME-USER-ENVIRONMENT)
  33.                                                      'NIL)))
  34. (SCHI:SET-FUNCTION-FROM-VALUE 'SCHEME-TRANSLATOR-SIG
  35.                               'SCHEME::SCHEME-TRANSLATOR-SIG)
  36. (LOCALLY
  37.   (DECLARE
  38.     (SPECIAL SCHEME-TRANSLATOR-MODULE
  39.              SCHEME-TRANSLATOR-ENV
  40.              SCHEME-TRANSLATOR-SIG))
  41.   (SETQ SCHEME-TRANSLATOR-MODULE (MAKE-MODULE 'SCHEME::SCHEME-TRANSLATOR
  42.                                               SCHEME-TRANSLATOR-SIG
  43.                                               SCHEME-TRANSLATOR-ENV)))
  44. (SCHI:SET-FUNCTION-FROM-VALUE 'SCHEME-TRANSLATOR-MODULE
  45.                               'SCHEME::SCHEME-TRANSLATOR-MODULE)
  46. (DEFUN MOVE-VALUE-OR-DENOTATION
  47.        (NAME FROM TO)
  48.        (LET ((DEN (PROGRAM-ENV-LOOKUP FROM NAME)))
  49.          (IF (AND (SCHI:TRUEP (NODE? DEN))
  50.                   (SCHI:TRUEP (PROGRAM-VARIABLE? DEN)))
  51.              (LET ((FROM-SYM (PROGRAM-VARIABLE-CL-SYMBOL DEN)))
  52.                (IF (BOUNDP FROM-SYM)
  53.                    (LET ((TO-SYM
  54.                            (PROGRAM-VARIABLE-CL-SYMBOL
  55.                              (PROGRAM-ENV-LOOKUP TO NAME))))
  56.                      (SETF (SYMBOL-VALUE TO-SYM)
  57.                            (SYMBOL-VALUE FROM-SYM))
  58.                      (SCHI:SET-FUNCTION-FROM-VALUE TO-SYM))
  59.                    (PROGRAM-ENV-DEFINE! TO NAME DEN)))
  60.              (PROGRAM-ENV-DEFINE! TO NAME DEN))))
  61. (SCHI:SET-VALUE-FROM-FUNCTION 'MOVE-VALUE-OR-DENOTATION
  62.                               'SCHEME::MOVE-VALUE-OR-DENOTATION)
  63. (LOCALLY (DECLARE (SPECIAL SCHEME-USER-ENVIRONMENT))
  64.          (SETQ SCHEME-USER-ENVIRONMENT (MAKE-PROGRAM-ENV 'SCHEME::SCHEME
  65.                                                          'NIL)))
  66. (SCHI:SET-FUNCTION-FROM-VALUE 'SCHEME-USER-ENVIRONMENT
  67.                               'SCHEME::SCHEME-USER-ENVIRONMENT)
  68. (SCHI:AT-TOP-LEVEL
  69.   (LOCALLY
  70.     (DECLARE
  71.       (SPECIAL REVISED^4-SCHEME-SIG
  72.                SCHEME-USER-ENVIRONMENT
  73.                REVISED^4-SCHEME-ENV))
  74.     (MAPC
  75.       #'(LAMBDA (NAME)
  76.          (MOVE-VALUE-OR-DENOTATION NAME REVISED^4-SCHEME-ENV
  77.           SCHEME-USER-ENVIRONMENT))
  78.       (SIGNATURE-NAMES REVISED^4-SCHEME-SIG))))
  79. (DEFUN PERFORM-USUAL-INTEGRATIONS!
  80.        (ENV)
  81.        (DECLARE (SPECIAL REVISED^4-SCHEME-SIG
  82.                          REVISED^4-SCHEME-ENV))
  83.        (MAPC
  84.          #'(LAMBDA (NAME)
  85.             (LET
  86.              ((PROBE
  87.                (GET-INTEGRATION
  88.                 (PROGRAM-ENV-LOOKUP REVISED^4-SCHEME-ENV NAME))))
  89.              (IF (SCHI:TRUEP PROBE)
  90.               (DEFINE-INTEGRATION! (PROGRAM-ENV-LOOKUP ENV NAME) PROBE))))
  91.          (SIGNATURE-NAMES REVISED^4-SCHEME-SIG)))
  92. (SCHI:SET-VALUE-FROM-FUNCTION 'PERFORM-USUAL-INTEGRATIONS!
  93.                               'SCHEME::PERFORM-USUAL-INTEGRATIONS!)
  94. (DEFUN EVAL-FOR-SYNTAX
  95.        (FORM ENV)
  96.        (EVAL (TRANSLATE FORM ENV)))
  97. (SCHI:SET-VALUE-FROM-FUNCTION 'EVAL-FOR-SYNTAX
  98.                               'SCHEME::EVAL-FOR-SYNTAX)
  99. (LOCALLY (DECLARE (SPECIAL SCHEME-USER-ENVIRONMENT
  100.                            SYNTAX-ERROR))
  101.          (LET ((ENV (GET-ENVIRONMENT-FOR-SYNTAX SCHEME-USER-ENVIRONMENT)))
  102.            (EVAL-FOR-SYNTAX '(SCHEME::DEFINE SCHEME::SYNTAX-ERROR
  103.                                              SCHI:FALSE)
  104.                             ENV)
  105.            (FUNCALL
  106.              (EVAL-FOR-SYNTAX
  107.                '(SCHEME::LAMBDA (SCHEME::X)
  108.                  (SCHEME::SET! SCHEME::SYNTAX-ERROR SCHEME::X))
  109.                ENV)
  110.              SYNTAX-ERROR)))
  111. (DEFUN .ERROR
  112.        (&REST .REST)
  113.        #+:LISPM
  114.        (SETQ .REST (COPY-LIST .REST))
  115.        (APPLY #'SCHI:SCHEME-ERROR .REST))
  116. (SCHI:SET-VALUE-FROM-FUNCTION '.ERROR 'SCHEME::ERROR)
  117.